Developer CD Series 1996 April: Mac OS SDK/Dev.CD Apr 96 SDK/Dev.CD Apr 96 SDK2.toast/Development Kits (Disc 2)/ScriptX/Draggable ScriptX Folders/utils/memory/rammeter/meter.sx

Text File | 1995-12-10 | 12.6 KB | 519 lines | [TEXT/ttxt]

--<<<

--
-- RAM_O_METER
-- Memory viewer
-- Ross Nelson
--
-- This memory viewer shows the total amount of ScriptX object heap used.
-- To try it out, build it with bldAll.sx.  Restart ScriptX, and load ram.sxt.
-- You'll get a small window showing amount of memory currently in black,
-- and a line showing the maximum reached in blue.
-- To test it out, try typing this in the listener, which allocates a megabyte
-- of memory:
--    b := new bytestring initialsize:1000000
-- To release this memory type  b := undefined.

module RamTool
    uses ScriptX

    exports RamTool,
            startupTool,
            shutdownTool
end

in module RamTool

--
-- globals
--

-- version checking
global constant versionMajor := 0
global constant versionMinor := 01
global constant releaseLevel := "a"                -- a-alpha, b-beta, dev-development

global constant oneMeg := 1024 * 1024
global constant numFrames := 20
global constant aRedBrush := new Brush color:(new RGBcolor red:255 green:0 blue:0)
global constant aBlueBrush := new Brush color:(new RGBcolor red:0 green:0 blue:255)

-- I know there's a bunch of globals but we're trying to be garbage free.
global totalMemFn := totalHeapSpace
global freeMemFn := totalFreeHeapSpace
global originalFreeSystemSpace
global originalTotalHeapSpace
global lastTotal := 0
global lastFree := 0
global scaleMax := 0
global lastMax := 0
global theRange := 1 to (numFrames - 1)
global resetNext := false
global mdown := new MouseDownEvent
global mup := new MouseUpEvent

-- forward
global updateDisplay
global doMouseDown
global doMouseUp

--
-- HashedLine
--
class HashedLine (TwoDShape)
inst vars
    nTicks
    hashMarks
    orientation
    setvarsFn
    drawFn
end

-- target must be rectangle specifying height of line, width of top&bottom hash marks
method init self {class HashedLine} #rest args #key nTicks:(4) orientation:(@vertical) -> (
    self.nTicks := nTicks
    self.orientation := orientation
    self.hashMarks := new Array initialSize:(self.nTicks + 2)
    apply nextMethod self args
    )

method afterInit self {class HashedLine} #rest args -> (
    apply nextMethod self args
    generateHash self

    -- create closures so draw can be garbage free
    local surface, clip, transform
    self.setvarsFn := (s c t ->
        surface := s; clip := c; transform := t
        )
    self.drawFn := (hash z ->
        stroke surface hash clip transform blackBrush
        )
    )

method generateHash self {class HashedLine} #rest args -> (
    local pos, width, height, chunk

    width := self.width
    height := self.height
    emptyOut self.hashMarks
    if (self.orientation == @vertical) then (
        pos := (width - 1) / 2
        chunk := height / self.nTicks
        self.hashMarks[1] := new line x1:pos x2:pos y1:0 y2:height
        self.hashMarks[2] := new line x1:0 x2:width y1:(height - 1) y2:(height - 1)
        self.hashMarks[3] := new line x1:0 x2:width y1:0 y2:0
        height := chunk
        for (self.nTicks - 1) do (
            append self.hashMarks (new line x1:(pos - 1) x2:(pos + 2) y1:height y2:height)
            height := height + chunk
            )
        )
    else (
        pos := (self.height - 1) / 2
        -- NYI
        )
    )

method draw self {class HashedLine} surface clip -> (
    nextMethod self surface clip
    self.setvarsFn surface clip self.transform
    foreach self.hashMarks self.drawFn 0
    )

--
-- ScaledRect
--
class ScaledRect (TwoDPresenter)
inst vars
    _value
    valueMax
    valueMin
    fillRect
    fillBrush
end

method init self {class ScaledRect} #rest args #key range:(0 to 100) target: fill:(blackBrush) -> (
    self.valueMax := range.upperBound
    self.valueMin := range.lowerBound
    self._value := 0
    self.fillRect := new rect x2:0 y2:target.y2
    self.fillBrush := fill
    apply nextMethod self args
    )

method get value self {class ScaledRect} -> (
    return self._value
    )

method set value self {class ScaledRect} val -> (
    if (val > self.valueMax) do
        val := self.valueMax
    if (val < self.valueMin) do
        val := self.valueMin

    self._value := val
    self.fillRect.height := round (((val - self.valueMin) / (self.valueMax - self.valueMin)) * self.target.height)
    self.fillRect.y1 := self.fillRect.y2 := self.target.y2
    return val
    )

method set height self {class ScaledRect} val -> (
    nextMethod self val
    self.fillRect.height := round (((val - self.valueMin) / (self.valueMax - self.valueMin)) * self.target.height)
    self.fillRect.y1 := self.fillRect.y2 := self.target.y2
    return val
    )

method set width self {class ScaledRect} val -> (
    self.fillRect.width := val
    nextMethod self val
    )

method draw self {class ScaledRect} surface clip -> (
    nextMethod self surface clip
    stroke surface self.fillRect clip self.transform self.fillBrush
    fill surface self.fillRect clip self.transform self.fillBrush
    )

--
-- Memory functions
--
function totalSystemSpace -> originalFreeSystemSpace

function totalMemory -> originalFreeSystemSpace + originalTotalHeapSpace

function totalFreeMemory -> totalFreeSystemSpace() + totalFreeHeapSpace()

--
-- RamTool
-- class that implements tool
--
class RamTool (ToolContainer)
inst vars
    transient clock
    transient cb
    transient cbRate
    transient window
    transient shapes
    transient displayMode
    transient skipDup
end

method afterLoading self {class RamTool} strm -> (
    self.clock := self.cb := self.window := self.shapes := undefined
    self.cbRate := 5
    nextMethod self strm
    )

-- NOTE:  Tool is not fully initialized after 'init' or
-- 'afterLoading', the 'prepareToRun' function must be called first
method prepareToRun self {class RamTool} -> (
    self.clock := new Clock title:self
    self.clock.rate := self.clock.scale := 1

    self.window := new Window type:@palette boundary:(new rect x2:200 y2:88) title:self
    self.window.x := 80
    self.window.y := 50

    mUp.device := mDown.device := new MouseDevice
    mUp.presenter := mDown.presenter := self.window
    mUp.authorData := mDown.authorData := self
    mDown.eventReceiver := doMouseDown
    mUp.eventReceiver := doMouseUp
    addEventInterest mDown

    self.shapes := new Array initialSize:(numFrames + 2)

    self.displayMode := @heap
    self.skipDup := true

    setupDisplay self
    setupMenus self
    updateDisplay self self.window self.shapes
    show self.window
    )

-- initialize menus
method setupMenus self {class RamTool} -> (
    local            menu, subMenu

    local fn setMemType tool opt val -> (
        if (opt == @update) do
            return if (val == tool.displayMode) then @enabledChecked else @enabled

        if (self.displayMode == val) do
            return

        self.displayMode := val
        resetNext := true
        )

    local fn setCallback tool opt val -> (
        if (opt == @update) do
            if (tool.cbRate = val) then
                return @enabledChecked
            else
                return @enabled

        cancel tool.cb
        tool.cbRate := val
        tool.cb := addPeriodicCallback tool.clock updateDisplay tool #(tool.window, tool.shapes) val
        tool.cb.skipIfLate := true
        )

    -- now build the menu
    menu := new ToolMenu name:"Ramometer"

    append menu (new ToolMenuItem name:"Show" menuFunc:(t i o ->
        if (o == @update) do
            return @enabled
        show t.window
        ))

    subMenu := new ToolMenu name:"Monitor"
    append subMenu (new ToolMenuItem name:"Heap Memory" menuFunc:(t i o -> setMemType t o @heap))
    append subMenu (new ToolMenuItem name:"System Memory" menuFunc:(t i o -> setMemType t o @system))
    append subMenu (new ToolMenuItem name:"All Memory" menuFunc:(t i o -> setMemType t o @all))
    append menu subMenu

    subMenu := new ToolMenu name:"Seconds between updates"
    append subMenu (new ToolMenuItem name:"1" menuFunc:(t i o -> setCallback t o 1))
    append subMenu (new ToolMenuItem name:"5" menuFunc:(t i o -> setCallback t o 5))
    append subMenu (new ToolMenuItem name:"15" menuFunc:(t i o -> setCallback t o 15))
    append subMenu (new ToolMenuItem name:"30" menuFunc:(t i o -> setCallback t o 30))
    append subMenu (new ToolMenuItem name:"60" menuFunc:(t i o -> setCallback t o 60))
    append menu subMenu

    append menu (new ToolMenuItem name:"Skip Duplicates" menuFunc:(t i o ->
        if (o == @update) do
            return if (t.skipDup) then @enabledChecked else @enabled

        t.skipDup := not t.skipDup
        ))


    append self.systemMenuBar menu
    menuChanged self.systemMenuBar
    )

global highWater := 0
global arglist := new array initialSize:2

fn updateDisplay tc win shapes -> (
    local total, free, inUse, r, l

    total := totalMemFn()
    free := freeMemFn()

    if (resetNext or (total > scaleMax)) do (
        resetNext := false
        cancel tc.cb
        setupDisplay tc
        total := totalMemFn()
        free := freeMemFn()
        )

    if (tc.skipDup) do
        if ((free > (lastFree - 100)) and (free < (lastFree + 100))) do
            return

    lastFree := free
    setNth arglist 1 win
    setNth arglist 2 shapes

    foreach theRange (ix args ->
        local win := getNth args 1
        local shapes := getNth args 2
        local td := getNth shapes ix
        local tdNext := getNth shapes (ix + 1)

        td.height := tdNext.height
        td.y := win.height - td.height - 4
        ) arglist

    highWater := total - freeMemFn()
    inUse := highWater / scaleMax
    r := getNth shapes numFrames
    r.height := round (80 * inUse)
    r.y := win.height - r.height - 4

    -- blue line
    l := getNth shapes (numFrames + 1)
    if (inUse > lastMax) do (
        lastMax := inUse
        l.y := r.y
        )

    -- red line
    l := getNth shapes (numFrames + 2)
    if (total > lastTotal) do (
        lastTotal := total
        l.y := win.height - (round (80 * (total / scaleMax))) - 4
        )
    )

global textInfo := undefined

function doMouseDown tc evint ev -> (
    local fromRed, fromBlue, mem

    addEventInterest mUp
    fromBlue := abs (ev.localCoords.y - tc.shapes[numFrames + 1].y)
    fromRed := abs (ev.localCoords.y - tc.shapes[numFrames + 2].y)
    if (fromBlue < fromRed) then (
        setDefaultAttr textInfo @brush aBlueBrush
        mem := highWater
        )
    else (
        setDefaultAttr textInfo @brush aRedBrush
        mem := totalMemFn()
        )

    mem := (mem / 1024) as Integer
    textInfo.target := (mem as String) + "K"
    textInfo.x := ev.localCoords.x
    textInfo.y := ev.localCoords.y - 12
    append tc.window textInfo
    )

function doMouseUp tc evint ev -> (
    removeEventInterest mUp
    deleteOne tc.window textInfo
    )

method setupDisplay self {class RamTool} -> (
    local megs, scale, anchorX, anchorY, td

    emptyout self.window
    emptyout self.shapes

    case self.displayMode of
        @heap:    (
            totalMemFn := totalHeapSpace
            freeMemFn := totalFreeHeapSpace
            self.window.name := "ScriptX Heap"
            )
        @system: (
            totalMemFn := totalSystemSpace
            freeMemFn := totalFreeSystemSpace
            self.window.name := "ScriptX System"
            )
        @all:    (
            totalMemFn := totalMemory
            freeMemFn := totalFreeMemory
            self.window.name := "ScriptX Memory"
            )
        end

    megs := if (self.displayMode == @heap) then
        totalHeapSpace() + (2 * oneMeg)        -- to allow for expansion
    else
        totalMemory()
    megs := 1 + (trunc (megs / oneMeg))

    scale := new HashedLine nTicks:megs target:(new rect x2:5 y2:80)
    scale.x := 4
    scale.y := 4
    append self.window scale

    scaleMax := megs * oneMeg
    lastTotal := 0
    lastMax := 0

    td := new textpresenter boundary:(new rect x2:20 y2:12) target:(megs as String)
    setDefaultAttr td @size 8
    setDefaultAttr td @leading 0
    td.x := 10
    td.y := 0
    append self.window td

    anchorX := 16
    anchorY := self.window.height - 4
    for i := 0 to (numFrames - 1) do (
        td := new twodshape target:(new rect x2:8 y2:0) stroke:blackBrush fill:blackBrush
        td.x := anchorX + (i * 8)
        td.y := anchorY - td.height
        append self.window td
        append self.shapes td
        )

    -- add another element to shapes array, line showing max position reached
    td := new twodshape target:(new line x2:160 y2:0) stroke:aBlueBrush
    td.x := anchorX
    td.y := anchorY
    append self.window td
    append self.shapes td

    -- add another element to shapes array, line showing top
    td := new twodshape target:(new line x2:160 y2:0) stroke:aRedBrush
    td.x := anchorX
    td.y := anchorY
    append self.window td
    append self.shapes td

    -- add support for mouse fn
    textInfo := new textpresenter boundary:(new rect x2:40 y2:12) target:"" fill:whiteBrush stroke:blackBrush
    setDefaultAttr textInfo @size 8
    setDefaultAttr textInfo @leading 0

    -- setup callback
    self.cb := addPeriodicCallback self.clock updateDisplay self #(self.window, self.shapes) self.cbRate
    self.cb.skipIfLate := true
    )

--
-- MENU HANDLERS
--

method toolAbout self { class RamTool } -> (
    local str, dlg

    print "Ramometer"
    )

method toolPrefs self { class RamTool } -> (
    OK
    )

method toolQuit self { class RamTool } -> (
    threadCriticalUp()
        if (self.cb !== undefined) do
            cancel self.cb
        if (self.clock !== undefined) do (
            self.clock.rate := 0
            self.clock := undefined
            )
        if (self.window !== undefined) do (
            removeEventInterest mDown
            hide self.window
            emptyOut self.window
            self.window := undefined
            )
    threadCriticalDown()
    )


--
--  STARTUP
--  startup action for title, must be compiled in this module
--
function startupTool tc -> (
    local notifyFn

    originalFreeSystemSpace := totalFreeSystemSpace()
    originalTotalHeapSpace := totalHeapSpace()
    foreach tc (mod z -> load mod) 0
    prepareToRun tc
    )

--
--  SHUTDOWN
--  shutdown action for title, must be compiled in this module
--
function shutdownTool tc -> (
    toolQuit tc
    )

-->>>